(library (interact)
  (export interactive-loop
          interact-search
          interact-learn)
  (import (except (rnrs base)
                  vector-for-each)
          (only (guile)
                lambda* λ
                simple-format
                current-output-port
                remainder
                member
                random
                pk)
          ;; GNU Guile batteries
          (ice-9 exceptions)
          (ice-9 match)
          ;; file system
          (fslib)
          ;; json
          (json)
          (json-reader)
          (json-writer)
          ;; custom libraries
          (vocabulary-data)
          (statistics)
          (print-utils)
          ;; custom helper libraries
          (list-procs)
          (alist-procs)
          (math)
          (search)
          (iter-utils)
          (print-utils)
          (bool-utils)
          ;; SRFIs
          (srfi srfi-1)
          ;; SRFI 8 - receive form
          (srfi srfi-8)
          ;; SRFI 43 - vector procs
          (srfi srfi-43)
          (vector-procs)
          ;; SRFI 69 - hash tables
          (srfi srfi-69)
          ;; other libs
          (user-input-output)
          (message-builder)))

;; ===========
;; INTERACTION
;; ===========

(define interact-select-searched-attributes
  (λ (vocabulary)
    "Ask the user which attributes of a vocabulary entry
they want to search in. Return a list of searched in
attributes."
    (let* ([attribute-names (vocabulary-get-attribute-names vocabulary)]
           [additional-choices '("all" "metadata" "translation-data")]
           [all-choices (append additional-choices attribute-names)]
           [num-attributes (length attribute-names)]
           [num-additonal-choices (length additional-choices)]
           [additional-choices-and-values
            `((0 . ,attribute-names)
              (1 . ,(vocabulary-get-metadata-attribute-names vocabulary))
              (2 . ,(vocabulary-get-translation-data-attribute-names vocabulary)))]
           [num-all-choices
            (+ num-attributes
               num-additonal-choices)]
           [attribute-choices
            ;; All choices are returned as a list -- makes later processing
            ;; simpler.
            (map (λ (e1 e2) (cons e1 (list e2)))
                 (range num-additonal-choices num-all-choices)
                 attribute-names)]
           [answer->value-hash-table
            (alist->hash-table
             (append additional-choices-and-values attribute-choices))]
           [message
            (string-append "Which attribute do you want to search?"
                           "\n"
                           (choices->message (range 0 num-all-choices) all-choices))])

      (let ([choice
             (ask-user-for-decision-return-value
              "Which attribute do you want to search?"
              (map number->string (range 0 num-all-choices))
              all-choices
              `(,attribute-names
                ,(vocabulary-get-metadata-attribute-names vocabulary)
                ,(vocabulary-get-translation-data-attribute-names vocabulary)
                ,@attribute-names)
              #:prompt-text "choose")])

        (simple-format (current-output-port) "~a\n" choice)
        (if (pair? choice) choice (cons choice '()))))))


(define interact-choose-number-comparison
  (lambda* (attribute-name)
    "Query the user for a number comparison."

    (define make-compare-as-numbers-otherwise-false
      (λ (compare-func)
        (λ (attr-val raw-input-value)
          (let ([input-value (string->number raw-input-value)])
            (if input-value
                (compare-func attr-val input-value)
                #f)))))

    (ask-user-for-decision-return-value
     (simple-format #f
                    "How do you want to compare the searched value with attribute ~a?"
                    attribute-name)
     '("<" ">" "<=" ">=" "=" "!=")
     '("less than"
       "greater than"
       "less than or equal"
       "greater than or equal"
       "equal"
       "not equal")
     (list (make-compare-as-numbers-otherwise-false
            (λ (attr-val input-value)
              (< attr-val input-value)))
           (make-compare-as-numbers-otherwise-false
            (λ (attr-val input-value)
              (> attr-val input-value)))
           (make-compare-as-numbers-otherwise-false
            (λ (attr-val input-value)
              (<= attr-val input-value)))
           (make-compare-as-numbers-otherwise-false
            (λ (attr-val input-value)
              (>= attr-val input-value)))
           (make-compare-as-numbers-otherwise-false
            (λ (attr-val input-value)
              (= attr-val input-value)))
           (make-compare-as-numbers-otherwise-false
            (λ (attr-val input-value)
              (not (= attr-val input-value))))))))


(define attribute-lookup
  (λ (vocabulary-entry attribute-name)
    ;; look for the attribute in the metadata
    (alist-refs vocabulary-entry
                (cons "metadata" (list attribute-name))
                ;; if the attribute is not in the
                ;; metadata look for it in the
                ;; translation-data
                #:default-thunk
                (λ ()
                  (alist-refs vocabulary-entry
                              (cons "translation-data" (list attribute-name))
                              #:default-thunk (λ () 'not-found))))))


(define interact-general-comparator
  (λ (vocabulary searched-attributes)
    "Query the user for ways in which attributes shall be
compared to the search term."
    ;; The first entry in the vocabulary is considered to be
    ;; somewhat special, as it is assumed to have the
    ;; structure, which all of the vocabulary entries are
    ;; expected to have and it is used as a guideline for
    ;; operations, which require knowledge about types.
    (let ([voc-entry (get:vocabulary/nth-entry vocabulary 0)])
      ;; TODO: find a good way to specify multiple
      ;; comparators for comparisons, which work with
      ;; the same type (for example numbers) but the
      ;; user wants them to work differently.
      (let next-attribute
          ([remaining-attributes searched-attributes]
           [string-comparator #f]
           [number-comparator #f]
           [boolean-comparator #f]
           [vector-comparator #f])
        (cond
         [(null? remaining-attributes)
          (make-general-comparator #:number-comparator number-comparator
                                   #:string-comparator string-comparator
                                   #:boolean-comparator boolean-comparator
                                   #:vector-comparator vector-comparator)]
         [else
          (cond
           [(and number-comparator
                 string-comparator
                 boolean-comparator
                 vector-comparator)
            (make-general-comparator #:number-comparator number-comparator
                                     #:string-comparator string-comparator
                                     #:boolean-comparator boolean-comparator
                                     #:vector-comparator vector-comparator)]
           [else
            (let* ([attr-name (first remaining-attributes)]
                   [attr-val (attribute-lookup voc-entry attr-name)])
              (cond
               [(number? attr-val)
                (next-attribute (cdr remaining-attributes)
                                string-comparator
                                (interact-choose-number-comparison attr-name)
                                boolean-comparator
                                vector-comparator)]
               [else
                (next-attribute (cdr remaining-attributes)
                                string-comparator
                                number-comparator
                                boolean-comparator
                                vector-comparator)]))])])))))


(define interactive-new-search
  (lambda* (vocabulary #:key (negated #f))
    "Search vocabulary interactively, asking the user what
attributes they would like to search for a search term."
    (let ([metadata (get:vocabulary/metadata vocabulary)]
          [searched-attributes (interact-select-searched-attributes vocabulary)])

      (define attribute-test
        (λ (attr)
          (member (get:attribute/key attr)
                  searched-attributes)))

      (define search-result
        (vocabulary-search vocabulary
                           (ask-user-for-text "" #:prompt-text "search term")
                           #:negated negated
                           #:equal-test?
                           (interact-general-comparator vocabulary searched-attributes)
                           #:attribute-test?
                           (λ (attr)
                             (member (alist-item-key attr)
                                     searched-attributes))))

      (values 'search-result
              `(("metadata" . ,metadata)
                ("words" . ,search-result))))))


(define interact-search
  (lambda* (vocabulary #:key (search-result-vocabulary #f))
    "Search vocabulary interactively."

    (let loop ()
      (ask-user-for-decision-with-continuations
       "How do you want to search?"
       '("s" "n" "!n" "w" "!w" "s0" "i" "e")
       '("new search"
         "narrow search results"
         "negated narrow search results"
         "widen search results"
         "negated widen search results"
         "reset search results"
         "show search result info"
         "exit")
       (list (λ ()
               (let-values ([(tag data) (interactive-new-search vocabulary)])
                 (interact-search vocabulary
                                  #:search-result-vocabulary
                                  data)))
             (λ ()
               (let-values ([(tag data) (interactive-new-search search-result-vocabulary)])
                 (interact-search vocabulary
                                  #:search-result-vocabulary
                                  data)))
             (λ ()
               (let-values ([(tag data)
                             (interactive-new-search search-result-vocabulary #:negated #t)])
                 (interact-search vocabulary
                                  #:search-result-vocabulary
                                  data)))
             (λ ()
               (let-values ([(tag data) (interactive-new-search vocabulary)])
                 (interact-search vocabulary
                                  #:search-result-vocabulary
                                  (vocabulary-union search-result-vocabulary data))))
             (λ ()
               (let-values ([(tag data) (interactive-new-search vocabulary #:negated #t)])
                 (interact-search vocabulary
                                  #:search-result-vocabulary
                                  (vocabulary-union search-result-vocabulary data))))
             (λ ()
               (interact-search vocabulary))
             (λ ()
               (vector-for-each (λ (ind res)
                                  (display-voc-entry res #:separator "---\n"))
                                (get:vocabulary/entries
                                 (if search-result-vocabulary
                                     search-result-vocabulary
                                     vocabulary)))
               (loop))
             (λ ()
               (print-limited search-result-vocabulary)
               (if search-result-vocabulary
                   (values 'search-result search-result-vocabulary)
                   (values 'vocabulary vocabulary))))))))


(define default-learn-config
  (alist-refs (get-json-from-file (fsing-join "settings.json"))
              '("learn")))

;; TODO: Implement a way to return the whole vocabulary
;; changed to the main interactive loop. One possible way to
;; achieve this is, to only pass a list of indices
;; accompanying the full vocabulary, instead of passing a
;; filtered vocabulary, so that using the indices entries of
;; the full vocabulary can be modified (mutated) and then
;; the full vocabulary can be returned.
(define interact-learn
  (lambda* (vocabulary #:key (config default-learn-config))
    (define question "What do you want to do?")
    (define choices '("n" "p" "sh" "i" "ml" "cd" "cr" "e"))
    (define choices-texts
      '("next word"
        "previous word"
        "shuffle words"
        "show word info"
        "mark word learned"
        "change difficulty"
        "change relevance"
        "exit learning"))

    (define meta-attr-visibility-pred
      (λ (attr-name)
        (let ([hidden-attrs
               (alist-refs default-learn-config
                           '("hidden-attributes" "metadata"))])
          (not (vector-contains hidden-attrs attr-name)))))

    (define translation-attr-visibility-pred
      (λ (attr-name)
        (let ([hidden-attrs
               (alist-refs default-learn-config
                           '("hidden-attributes" "translation-data"))])
          (not (vector-contains hidden-attrs attr-name)))))

    (define learn-loop
      (λ (voc-entries index)
        (let ([voc-entry (vector-ref voc-entries index)])
          (display-voc-entry voc-entry
                             #:meta-attr-visibility-pred
                             meta-attr-visibility-pred
                             #:translation-attr-visibility-pred
                             translation-attr-visibility-pred))
        (let ([repeat
               (λ ()
                 (let ([next-index (remainder index (vector-length voc-entries))])
                   (learn-loop voc-entries next-index)))])
          (ask-user-for-decision-with-continuations
           question
           choices
           choices-texts
           (list (λ ()
                   (learn-loop voc-entries
                               (next-in-circle index (vector-length voc-entries))))
                 (λ ()
                   (learn-loop voc-entries
                               (previous-in-circle index (vector-length voc-entries))))
                 (λ ()
                   (learn-loop (vector-shuffle voc-entries) 0))
                 (λ ()
                   (display-voc-entry (vector-ref voc-entries index)
                                      #:meta-attr-visibility-pred
                                      (λ (attr-name) #t)
                                      #:translation-attr-visibility-pred
                                      (λ (attr-name) #t))
                   (repeat))
                 (λ ()
                   (entries:set-learned-status! voc-entries
                                                (list index)
                                                (list #t))
                   (print-limited "continuing with modified entry:")
                   (print-limited (vector-ref voc-entries index))
                   (learn-loop voc-entries
                               (next-in-circle index (vector-length voc-entries))))
                 (λ ()
                   (simple-format (current-output-port) "change difficulty - not yet implemented\n")
                   (repeat))
                 (λ ()
                   (simple-format (current-output-port) "change relevance - not yet implemented\n")
                   (repeat))
                 (λ ()
                   ;; TODO: return filtered or not filtered
                   ;; (symbol), depending on how learn was
                   ;; started
                   (values 'update
                           `(("metadata" . ,(get:vocabulary/metadata vocabulary))
                             ("words" . ,voc-entries)))))))))

    (cond
     [(> (vocabulary/entries:length vocabulary) 0)
      (learn-loop (get:vocabulary/entries vocabulary) 0)]
     [else
      (confirm-info-message "empty vocabulary subset")
      (values 'search-result vocabulary)])))


(define interact-persist
  (λ (vocabulary settings)
    (let ([file-location
           (hash-table-ref/default settings
                                   "vocabulary"
                                   "default-vocabulary.json")])
      (save-vocabulary file-location vocabulary))
    (values 'continue vocabulary)))


(define interact-reload
  (λ (settings)
    (values 'continue
            (read-vocabulary
             (hash-table-ref/default settings
                                     "vocabulary"
                                     "default-vocabulary.json")))))


(define interactive-loop
  (lambda* (vocabulary settings #:key (search-result-vocabulary #f))

    (define choices-with-texts
      `(("s" . "search")
        ("l" . "learn")
        ("p" . "persist data")
        ("r" . "reload data")
        ("stat" . "show statistics")
        ("e" . "exit")))

    (define continuations
      (list (λ () (interact-search vocabulary #:search-result-vocabulary search-result-vocabulary))
            (λ () (interact-learn (or search-result-vocabulary vocabulary)))
            (λ () (interact-persist vocabulary settings))
            (λ () (interact-reload settings))
            (λ ()
              (display-statistics (or search-result-vocabulary vocabulary))
              (cond
               [search-result-vocabulary
                (values 'search-result search-result-vocabulary)]
               [else
                (values 'vocabulary vocabulary)]))
            (λ ()
              (values 'exit 'none))))

    (define loop
      (lambda* ()
        (let-values ([(tag data)
                      (ask-user-for-decision-with-continuations
                       "What do you want to do?"
                       (map (λ (elem) (car elem)) choices-with-texts)
                       (map (λ (elem) (cdr elem)) choices-with-texts)
                       continuations)])
          (cond
           [(eq? tag 'search-result)
            (vector-for-each (λ (ind res) (display-voc-entry res #:separator "---\n"))
                             (get:vocabulary/entries data))
            (interactive-loop vocabulary settings #:search-result-vocabulary data)]
           [(eq? tag 'vocabulary)
            (interactive-loop vocabulary settings #:search-result-vocabulary #f)]
           [(eq? tag 'continue)
            (interactive-loop vocabulary settings #:search-result-vocabulary #f)]
           [(eq? tag 'update)
            (simple-format (current-output-port) "~a\n" "updating vocabulary")
            (interactive-loop (vocabulary-merge vocabulary data)
                              settings
                              #:search-result-vocabulary data)]
           [(eq? tag 'exit)
            'exit]
           [else
            (raise-exception
             (make-exception
              (make-non-continuable-error)
              (make-exception-with-message
               "unexpected return value to interactive main loop")
              (make-exception-with-irritants data)
              (make-exception-with-origin 'interactive-loop)))]))))

    ;; start the interaction loop, with unfiltered vocabulary
    (loop)))
